Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue38/Alfresco/Graphs.pas

Pascal/Delphi Source File | 1998-09-01 | 18KB | 577 lines

unit Graphs;

interface

uses
  SysUtils, Classes;

type
  TaaGraph = class
    private
      gIsDigraph : boolean;
      gNodeCount : integer;
    protected
      function gGetEdge(aFromIndex, aToIndex : integer) : pointer; virtual; abstract;
      function gGetNode(aIndex : integer) : pointer; virtual; abstract;
      procedure gSetEdge(aFromIndex, aToIndex : integer;
                          aValue : pointer); virtual; abstract;
      procedure gSetNode(aIndex : integer; aValue : pointer); virtual; abstract;
    public
      constructor Create(aNodeCount : integer);

      function GetNodeEdge(aFromIndex : integer;
                           aNthEdge   : integer;
                       var aEdge      : pointer;
                       var aToIndex   : integer) : boolean; virtual; abstract;

      property Edges[aFromIndex, aToIndex : integer] : pointer
         read gGetEdge write gSetEdge;

      property IsDigraph : boolean
         read gIsDigraph;

      property NodeCount : integer
         read gNodeCount;

      property Nodes[aIndex : integer] : pointer
         read gGetNode write gSetNode;
  end;

  TaaFullMatrixGraph = class(TaaGraph)
    private
      mgNodes : TList;
      mgEdges : TList;
    protected
      function gGetEdge(aFromIndex, aToIndex : integer) : pointer; override;
      function gGetNode(aIndex : integer) : pointer; override;
      procedure gSetEdge(aFromIndex, aToIndex : integer;
                          aValue : pointer); override;
      procedure gSetNode(aIndex : integer; aValue : pointer); override;

    public
      constructor Create(aNodeCount : integer; aIsDigraph : boolean);
      destructor Destroy; override;

      function GetNodeEdge(aFromIndex : integer;
                           aNthEdge   : integer;
                       var aEdge      : pointer;
                       var aToIndex   : integer) : boolean; override;
  end;

  TaaTriMatrixGraph = class(TaaGraph)
    private
      mgNodes : TList;
      mgEdges : TList;
    protected
      function gGetEdge(aFromIndex, aToIndex : integer) : pointer; override;
      function gGetNode(aIndex : integer) : pointer; override;
      procedure gSetEdge(aFromIndex, aToIndex : integer;
                          aValue : pointer); override;
      procedure gSetNode(aIndex : integer; aValue : pointer); override;

    public
      constructor Create(aNodeCount : integer);
      destructor Destroy; override;

      function GetNodeEdge(aFromIndex : integer;
                           aNthEdge   : integer;
                       var aEdge      : pointer;
                       var aToIndex   : integer) : boolean; override;
  end;

  TaaLinkListGraph = class(TaaGraph)
    private
      lgNodes : TList;
    protected
      function gGetEdge(aFromIndex, aToIndex : integer) : pointer; override;
      function gGetNode(aIndex : integer) : pointer; override;
      procedure gSetEdge(aFromIndex, aToIndex : integer;
                          aValue : pointer); override;
      procedure gSetNode(aIndex : integer; aValue : pointer); override;

      procedure lgCreateEmptyLinkedList(aAtIndex : integer);
      procedure lgDestroyLinkedList(aAtIndex : integer);
      procedure lgSetEdgePrim(aFromIndex, aToIndex : integer;
                              aValue : pointer);
    public
      constructor Create(aNodeCount : integer; aIsDigraph : boolean);
      destructor Destroy; override;

      function GetNodeEdge(aFromIndex : integer;
                           aNthEdge   : integer;
                       var aEdge      : pointer;
                       var aToIndex   : integer) : boolean; override;
  end;

type
  TaaProcessNode = procedure (aSender  : TObject;
                              aNodeInx : integer);

  TaaDepthFirstIterator = class
    private
      dfiGraph       : TaaGraph;
      dfiNodes       : TList;
      dfiPostProcess : TaaProcessNode;
      dfiPreProcess  : TaaProcessNode;
    protected
      procedure dfiDestroyCounter(aIndex : integer);
    public
      constructor Create(aGraph : TaaGraph);
      destructor Destroy; override;

      procedure Execute(aFromIndex : integer);
      procedure Reset;

      property OnPreProcess : TaaProcessNode
         read dfiPreProcess write dfiPreProcess;
      property OnPostProcess : TaaProcessNode
         read dfiPostProcess write dfiPostProcess;
  end;


implementation

type
  PllNode = ^TllNode;
  TllNode = packed record
    llnNext    : PllNode; // next node
    llnNodeInx : integer; // node index
    case boolean of
      false : (llnEdge : pointer); // edge value
      true  : (llnNode : pointer); // node value
  end;


constructor TaaGraph.Create(aNodeCount : integer);
begin
  inherited Create;
  gNodeCount := aNodeCount;
end;


constructor TaaFullMatrixGraph.Create(aNodeCount : integer; aIsDigraph : boolean);
begin
  inherited Create(aNodeCount);
  mgNodes := TList.Create;
  mgNodes.Count := aNodeCount;
  mgEdges := TList.Create;
  mgEdges.Count := aNodeCount * aNodeCount;
  gIsDigraph := aIsDigraph;
end;

destructor TaaFullMatrixGraph.Destroy;
begin
  mgEdges.Free;
  mgNodes.Free;
  inherited Destroy;
end;

function TaaFullMatrixGraph.GetNodeEdge(aFromIndex : integer;
                                        aNthEdge   : integer;
                                    var aEdge      : pointer;
                                    var aToIndex   : integer) : boolean;
var
  i          : integer;
  BeginIndex : integer;
begin
  Result := false;
  if (aFromIndex < 0) or
     (aFromIndex >= mgNodes.Count) or
     (aNthEdge < 0) then
    Exit;
  BeginIndex := aFromIndex * NodeCount;
  for i := BeginIndex to pred(BeginIndex + NodeCount) do begin
    if (mgEdges[i] <> nil) then begin
      if (aNthEdge = 0) then begin
        Result := true;
        aEdge := mgEdges[i];
        aToIndex := i - BeginIndex;
        Exit;
      end;
      dec(aNthEdge);
    end;
  end;
end;

function TaaFullMatrixGraph.gGetEdge(aFromIndex, aToIndex : integer) : pointer;
begin
  if (aFromIndex < 0) or (aFromIndex >= mgNodes.Count) then
    raise Exception.Create('TaaTriMatrixGraph.gGetEdge: from node index out of range');
  if (aToIndex < 0) or (aToIndex >= mgNodes.Count) then
    raise Exception.Create('TaaTriMatrixGraph.gGetEdge: to node index out of range');
  Result := mgEdges[(aFromIndex * NodeCount) + aToIndex];
end;

function TaaFullMatrixGraph.gGetNode(aIndex : integer) : pointer;
begin
  if (aIndex < 0) or (aIndex >= mgNodes.Count) then
    raise Exception.Create('TaaTriMatrixGraph.gGetNode: node index out of range');
  Result := mgNodes[aIndex];
end;

procedure TaaFullMatrixGraph.gSetEdge(aFromIndex, aToIndex : integer;
                                     aValue : pointer);
begin
  if (aFromIndex < 0) or (aFromIndex >= mgNodes.Count) then
    raise Exception.Create('TaaTriMatrixGraph.gSetEdge: from node index out of range');
  if (aToIndex < 0) or (aToIndex >= mgNodes.Count) then
    raise Exception.Create('TaaTriMatrixGraph.gSetEdge: to node index out of range');
  mgEdges[(aFromIndex * NodeCount) + aToIndex] := aValue;
  if (not IsDigraph) and (aFromIndex <> aToIndex) then
    mgEdges[(aToIndex * NodeCount) + aFromIndex] := aValue;
end;

procedure TaaFullMatrixGraph.gSetNode(aIndex : integer; aValue : pointer);
begin
  if (aIndex < 0) or (aIndex >= mgNodes.Count) then
    raise Exception.Create('TaaTriMatrixGraph.gSetNode: node index out of range');
  mgNodes[aIndex] := aValue;
end;


constructor TaaTriMatrixGraph.Create(aNodeCount : integer);
begin
  inherited Create(aNodeCount);
  mgNodes := TList.Create;
  mgNodes.Count := aNodeCount;
  mgEdges := TList.Create;
  mgEdges.Count := (aNodeCount * succ(aNodeCount)) div 2;
end;

destructor TaaTriMatrixGraph.Destroy;
begin
  mgEdges.Free;
  mgNodes.Free;
  inherited Destroy;
end;

function TaaTriMatrixGraph.GetNodeEdge(aFromIndex : integer;
                                       aNthEdge   : integer;
                                   var aEdge      : pointer;
                                   var aToIndex   : integer) : boolean;
var
  ArrayInx : integer;
  ToIndex  : integer;
begin
  Result := false;
  if (aFromIndex < 0) or
     (aFromIndex >= mgNodes.Count) or
     (aNthEdge < 0) then
    Exit;
  ArrayInx := (aFromIndex * succ(aFromIndex)) div 2;
  ToIndex := 0;
  {first go along horizontally along a row}
  while (ToIndex <= aFromIndex) do begin
    if (mgEdges[ArrayInx] <> nil) then begin
      if (aNthEdge = 0) then begin
        Result := true;
        aEdge := mgEdges[ArrayInx];
        aToIndex := ToIndex;
        Exit;
      end;
      dec(aNthEdge);
    end;
    inc(ToIndex);
    inc(ArrayInx);
  end;
  {then go vertically down a column}
  inc(ArrayInx, pred(ToIndex));
  while (ToIndex < NodeCount) do begin
    if (mgEdges[ArrayInx] <> nil) then begin
      if (aNthEdge = 0) then begin
        Result := true;
        aEdge := mgEdges[ArrayInx];
        aToIndex := ToIndex;
        Exit;
      end;
      dec(aNthEdge);
    end;
    inc(ToIndex);
    inc(ArrayInx, ToIndex);
  end;
end;

function TaaTriMatrixGraph.gGetEdge(aFromIndex, aToIndex : integer) : pointer;
var
  Temp : integer;
begin
  if (aFromIndex < 0) or (aFromIndex >= mgNodes.Count) then
    raise Exception.Create('TaaTriMatrixGraph.gGetEdge: from node index out of range');
  if (aToIndex < 0) or (aToIndex >= mgNodes.Count) then
    raise Exception.Create('TaaTriMatrixGraph.gGetEdge: to node index out of range');
  if (aFromIndex < aToIndex) then begin
    Temp := aFromIndex;
    aFromIndex := aToIndex;
    aToIndex := Temp;
  end;
  Result := mgEdges[(aFromIndex * succ(aFromIndex)) div 2 + aToIndex];
end;

function TaaTriMatrixGraph.gGetNode(aIndex : integer) : pointer;
begin
  if (aIndex < 0) or (aIndex >= mgNodes.Count) then
    raise Exception.Create('TaaTriMatrixGraph.gGetNode: node index out of range');
  Result := mgNodes[aIndex];
end;

procedure TaaTriMatrixGraph.gSetEdge(aFromIndex, aToIndex : integer;
                                     aValue : pointer);
var
  Temp : integer;
begin
  if (aFromIndex < 0) or (aFromIndex >= mgNodes.Count) then
    raise Exception.Create('TaaTriMatrixGraph.gSetEdge: from node index out of range');
  if (aToIndex < 0) or (aToIndex >= mgNodes.Count) then
    raise Exception.Create('TaaTriMatrixGraph.gSetEdge: to node index out of range');
  if (aFromIndex < aToIndex) then begin
    Temp := aFromIndex;
    aFromIndex := aToIndex;
    aToIndex := Temp;
  end;
  mgEdges[(aFromIndex * succ(aFromIndex)) div 2 + aToIndex] := aValue;
end;

procedure TaaTriMatrixGraph.gSetNode(aIndex : integer; aValue : pointer);
begin
  if (aIndex < 0) or (aIndex >= mgNodes.Count) then
    raise Exception.Create('TaaTriMatrixGraph.gSetNode: node index out of range');
  mgNodes[aIndex] := aValue;
end;


constructor TaaLinkListGraph.Create(aNodeCount : integer; aIsDigraph : boolean);
var
  i : integer;
begin
  inherited Create(aNodeCount);
  lgNodes := TList.Create;
  lgNodes.Count := aNodeCount;
  for i := 0 to pred(aNodeCount) do
    lgCreateEmptyLinkedList(i);
  gIsDigraph := aIsDigraph;
end;

destructor TaaLinkListGraph.Destroy;
var
  i : integer;
begin
  for i := 0 to pred(NodeCount) do
    lgDestroyLinkedList(i);
  lgNodes.Free;
  inherited Destroy;
end;

function TaaLinkListGraph.GetNodeEdge(aFromIndex : integer;
                                      aNthEdge   : integer;
                                  var aEdge      : pointer;
                                  var aToIndex   : integer) : boolean;
var
  WalkNode : PllNode;
begin
  Result := false;
  if (aFromIndex < 0) or
     (aFromIndex >= lgNodes.Count) or
     (aNthEdge < 0) then
    Exit;
  WalkNode := lgNodes[aFromIndex];
  while (WalkNode <> nil) and (aNthEdge >= 0) do begin
    WalkNode := WalkNode^.llnNext;
    dec(aNthEdge);
  end;
  if (WalkNode = nil) or (WalkNode^.llnNext = nil) then
    Exit;
  Result := true;
  aEdge := WalkNode^.llnEdge;
  aToIndex := WalkNode^.llnNodeInx;
end;

function TaaLinkListGraph.gGetEdge(aFromIndex, aToIndex : integer) : pointer;
var
  WalkNode : PllNode;
begin
  if (aFromIndex < 0) or (aFromIndex >= lgNodes.Count) then
    raise Exception.Create('TaaLinkListGraph.gSetEdge: from node index out of range');
  if (aToIndex < 0) or (aToIndex >= lgNodes.Count) then
    raise Exception.Create('TaaLinkListGraph.gSetEdge: to node index out of range');
  Result := nil;
  WalkNode := lgNodes[aFromIndex];
  while (WalkNode^.llnNodeInx < aToIndex) do
    WalkNode := WalkNode^.llnNext;
  if (WalkNode^.llnNodeInx = aToIndex) then
    Result := WalkNode^.llnEdge;
end;

function TaaLinkListGraph.gGetNode(aIndex : integer) : pointer;
begin
  if (aIndex < 0) or (aIndex >= lgNodes.Count) then
    raise Exception.Create('TaaLinkListGraph.gGetNode: node index out of range');
  Result := PllNode(lgNodes[aIndex])^.llnNode;
end;

procedure TaaLinkListGraph.gSetEdge(aFromIndex, aToIndex : integer;
                                    aValue : pointer);
begin
  if (aFromIndex < 0) or (aFromIndex >= lgNodes.Count) then
    raise Exception.Create('TaaLinkListGraph.gSetEdge: from node index out of range');
  if (aToIndex < 0) or (aToIndex >= lgNodes.Count) then
    raise Exception.Create('TaaLinkListGraph.gSetEdge: to node index out of range');
  lgSetEdgePrim(aFromIndex, aToIndex, aValue);
  if (not IsDigraph) and (aFromIndex <> aToIndex) then
    lgSetEdgePrim(aToIndex, aFromIndex, aValue);
end;

procedure TaaLinkListGraph.gSetNode(aIndex : integer; aValue : pointer);
begin
  if (aIndex < 0) or (aIndex >= lgNodes.Count) then
    raise Exception.Create('TaaLinkListGraph.gSetNode: node index out of range');
  PllNode(lgNodes[aIndex])^.llnNode := aValue;
end;

procedure TaaLinkListGraph.lgCreateEmptyLinkedList(aAtIndex : integer);
var
  FirstNode : PllNode;
  LastNode : PllNode;
begin
  New(LastNode);
  with LastNode^ do begin
    llnNext := nil;
    llnEdge := nil;
    llnNodeInx := $7FFFFFFF; // greater than any node index
  end;
  New(FirstNode);
  with FirstNode^ do begin
    llnNext := LastNode;
    llnNode := nil;
    llnNodeInx := -1; // less than any node index
  end;
  lgNodes[aAtIndex] := FirstNode;
end;

procedure TaaLinkListGraph.lgDestroyLinkedList(aAtIndex : integer);
var
  Dad, Son : PllNode;
begin
  Son := lgNodes[aAtIndex];
  while (Son <> nil) do begin
    Dad := Son;
    Son := Dad^.llnNext;
    Dispose(Dad);
  end;
end;

procedure TaaLinkListGraph.lgSetEdgePrim(aFromIndex, aToIndex : integer;
                                         aValue : pointer);
var
  DadNode, WalkNode, NewNode : PllNode;
begin
  DadNode := nil;
  WalkNode := lgNodes[aFromIndex];
  while (WalkNode^.llnNodeInx < aToIndex) do begin
    DadNode := WalkNode;
    WalkNode := DadNode^.llnNext;
  end;
  if (WalkNode^.llnNodeInx = aToIndex) then
    WalkNode^.llnEdge := aValue
  else begin
    New(NewNode);
    with NewNode^ do begin
      llnNext := WalkNode;
      llnEdge := aValue;
      llnNodeInx := aToIndex;
    end;
    DadNode^.llnNext := NewNode;
  end;
end;


type
  PdfiCounter = ^TdfiCOunter;
  TdfiCounter = packed record
    cMarker : integer;
    cParent : integer;
    cLevel  : integer;
  end;

constructor TaaDepthFirstIterator.Create(aGraph : TaaGraph);
var
  i : integer;
begin
  inherited Create;
  dfiGraph := aGraph;
  dfiNodes := TList.Create;
  dfiNodes.Count := aGraph.NodeCount;
  for i := 0 to pred(dfiNodes.Count) do
    dfiNodes[i] := AllocMem(sizeof(TdfiCounter));
  Reset;
end;

destructor TaaDepthFirstIterator.Destroy;
var
  i : integer;
begin
  for i := 0 to pred(dfiNodes.Count) do
    dfiDestroyCounter(i);
  inherited Destroy;
end;

procedure TaaDepthFirstIterator.dfiDestroyCounter(aIndex : integer);
var
  Counter : PdfiCounter;
begin
  Counter := dfiNodes[aIndex];
  if (Counter <> nil) then
    Dispose(Counter);
end;

procedure TaaDepthFirstIterator.Execute(aFromIndex : integer);
var
  i          : integer;
  NewNodeInx : integer;
  Edge       : pointer;
  OurLevel   : integer;
begin
  // perform preprocessing on the node
  if Assigned(dfiPreProcess) then
    dfiPreProcess(Self, aFromIndex);
  // mark the node as preprocessed
  with PdfiCounter(dfiNodes[aFromIndex])^ do begin
    cMarker := 1;
    OurLevel := cLevel;
  end;
  // iterate through the edges from this node
  i := 0;
  while dfiGraph.GetNodeEdge(aFromIndex, i, Edge, NewNodeInx) do begin
    with PdfiCounter(dfiNodes[NewNodeInx])^ do begin
      if (cMarker = 0) then begin
        cParent := aFromIndex;
        cLevel := succ(OurLevel);
        Execute(NewNodeInx);
      end;
    end;
    inc(i);
  end;
  // perform postprocessing on the node
  if Assigned(dfiPostProcess) then
    dfiPostProcess(Self, aFromIndex);
  // mark the node as postprocessed
  with PdfiCounter(dfiNodes[aFromIndex])^ do begin
    cMarker := 2;
  end;
end;

procedure TaaDepthFirstIterator.Reset;
var
  i : integer;
begin
  for i := 0 to pred(dfiNodes.Count) do begin
    with PdfiCounter(dfiNodes[i])^ do begin
      cMarker := 0;
      cParent := -1;
      cLevel  := 0;
    end;
  end;
end;


end.